home
***
CD-ROM
|
disk
|
FTP
|
other
***
search
/
Tech Arsenal 1
/
Tech Arsenal (Arsenal Computer).ISO
/
tek-02
/
jed10.zip
/
TEXTINFO.PAS
< prev
next >
Wrap
Pascal/Delphi Source File
|
1993-02-26
|
9KB
|
278 lines
{--------------------------------------------------------------}
{ TextInfo }
{ }
{ Text video information library }
{ }
{ by Jeff Duntemann }
{ Turbo Pascal V5.0 }
{ Last update 11/20/88 }
{--------------------------------------------------------------}
UNIT TextInfo;
INTERFACE
USES DOS;
TYPE
AdapterType = (None,MDA,CGA,EGAMono,EGAColor,VGAMono,
VGAColor,MCGAMono,MCGAColor);
FontSize = (Font8,Font14,Font16);
{ The following type definition *requires* Turbo Pascal 5.0! }
OverrideProc = PROCEDURE(VAR ForceX : Byte; VAR ForceY : Byte);
VAR
TextBufferOrigin : Pointer;
TextBufferSize : Word;
VisibleX,VisibleY : Byte;
FUNCTION GetBIOSTextMode : Byte; { Returns BIOS text mode }
FUNCTION GetFontSize : FontSize; { Returns font height code }
FUNCTION GetTextBufferOrigin : Pointer; { Returns pointer to text buffer }
{ Returns visible X and Y extent plus buffer size in bytes: }
PROCEDURE GetTextBufferStats(VAR BX : Byte;
VAR BY : Byte;
VAR BuffSize : Word;
CheckForOverride : OverrideProc);
FUNCTION Monochrome : Boolean; { Returns True if monochrome display }
PROCEDURE NullOverride(VAR ForceX : Byte; VAR ForceY : Byte);
FUNCTION QueryAdapterType : AdapterType; { Returns installed display }
FUNCTION FontCode(Height : Byte) : FontSize; { Returns font height code }
FUNCTION FontHeight(Code : FontSize) : Byte; { Returns font height value}
IMPLEMENTATION
FUNCTION GetBIOSTextMode : Byte;
VAR
Regs : Registers; { Type Registers is exported by the DOS unit }
BEGIN
Regs.AH := $0F; { BIOS VIDEO Service $F: Get Current Video Mode }
Intr($10,Regs);
GetBIOSTextMode := Regs.AL; { Mode is returned in AL }
END;
FUNCTION QueryAdapterType : AdapterType;
VAR
Regs : Registers; { Type Registers is exported by the DOS unit }
Code : Byte;
BEGIN
Regs.AH := $1A; { Attempt to call VGA Identify Adapter Function }
Regs.AL := $00; { Must clear AL to 0 ... }
Intr($10,Regs);
IF Regs.AL = $1A THEN { ...so that if $1A comes back in AL... }
BEGIN { ...we know a PS/2 video BIOS is out there. }
CASE Regs.BL OF { Code comes back in BL }
$00 : QueryAdapterType := None;
$01 : QueryAdapterType := MDA;
$02 : QueryAdapterType := CGA;
$04 : QueryAdapterType := EGAColor;
$05 : QueryAdapterType := EGAMono;
$07 : QueryAdapterType := VGAMono;
$08 : QueryAdapterType := VGAColor;
$0A,$0C : QueryAdapterType := MCGAColor;
$0B : QueryAdapterType := MCGAMono;
ELSE QueryAdapterType := CGA
END { CASE }
END
ELSE
{ If it's not PS/2 we have to check for the presence of an EGA BIOS: }
BEGIN
Regs.AH := $12; { Select Alternate Function service }
Regs.BX := $10; { BL=$10 means return EGA information }
Intr($10,Regs); { Call BIOS VIDEO }
IF Regs.BX <> $10 THEN { BX unchanged means EGA is NOT there...}
BEGIN
Regs.AH := $12; { Once we know Alt Function exists... }
Regs.BL := $10; { ...we call it again to see if it's... }
Intr($10,Regs); { ...EGA color or EGA monochrome. }
IF (Regs.BH = 0) THEN QueryAdapterType := EGAColor
ELSE QueryAdapterType := EGAMono
END
ELSE { Now we know we have an CGA or MDA; let's see which: }
BEGIN
Intr($11,Regs); { Equipment determination service }
Code := (Regs.AL AND $30) SHR 4;
CASE Code of
1 : QueryAdapterType := CGA;
2 : QueryAdapterType := CGA;
3 : QueryAdapterType := MDA
ELSE QueryAdapterType := None
END { Case }
END
END;
END;
{ All we're doing here is converting numeric font heights }
{ to their corresponding values of type FontSize. }
FUNCTION FontCode(Height : Byte) : FontSize;
BEGIN
CASE Height OF
8 : FontCode := Font8;
14 : FontCode := Font14;
16 : FontCode := Font16;
END { CASE }
END;
{ Likewise, this function converts values of type FontSize }
{ to their corresponding numeriuc values. }
FUNCTION FontHeight(Code : FontSize) : Byte;
BEGIN
CASE Code OF
Font8 : FontHeight := 8;
Font14 : FontHeight := 14;
Font16 : FontHeight := 16;
END { CASE }
END;
FUNCTION GetFontSize : FontSize;
VAR
Regs : Registers; { Type Registers is exported by the DOS unit }
BEGIN
CASE QueryAdapterType OF
CGA : GetFontSize := Font8;
MDA : GetFontSize := Font14;
MCGAMono,
MCGAColor : GetFontSize := Font16; { Wretched thing knows but 1 font! }
EGAMono, { These adapters may be using any of several different }
EGAColor, { font cell heights, so we need to query the BIOS to }
VGAMono, { find out which is currently in use. }
VGAColor : BEGIN
WITH Regs DO
BEGIN
AH := $11; { EGA/VGA Information Call }
AL := $30;
BH := 0;
END;
Intr($10,Regs); { On return, CX contains the font height }
GetFontSize := FontCode(Regs.CX);
END
END { CASE }
END;
FUNCTION GetTextBufferOrigin : Pointer;
{ The rule is: For boards attached to monochrome monitors, the buffer }
{ origin is $B000:0; for boards attached to color monitors (including }
{ all composite monitors and TV's) the buffer origin is $B800:0. }
BEGIN
CASE QueryAdapterType OF
CGA,MCGAColor,EGAColor,VGAColor : GetTextBufferOrigin := Ptr($B800,0);
MDA,MCGAMono, EGAMono, VGAMono : GetTextBufferOrigin := Ptr($B000,0);
END { CASE }
END;
{ This proc provides initial values for the dimensions of the visible }
{ display and (hence) the size of the visible refresh buffer. It is }
{ called by the initialization section during startup *BUT* you must }
{ call it again after any mode change or font change to be sure of }
{ having accurate values in the three variables! }
PROCEDURE GetTextBufferStats(VAR BX : Byte; { Visible X dimension }
VAR BY : Byte; { Visible Y dimension }
VAR BuffSize : Word; { Refresh buffer size }
{ This requires TP5.0! } CheckForOverride : OverrideProc);
CONST
ScreenLinesMatrix : ARRAY[AdapterType,FontSize] OF Integer =
{ Font8: Font14: Font16: }
{ None: } ((25, 25, 25),
{ MDA: } (-1, 25, -1),
{ CGA: } (25, -1, -1),
{ EGAMono: } (43, 25, -1),
{ EGAColor: } (43, 25, -1),
{ VGAMono: } (50, 28, 25),
{ VGAColor: } (50, 28, 25),
{ MCGAMono: } (-1, -1, 25),
{ MCGAColor: } (-1, -1, 25));
VAR
Regs : Registers; { Type Registers is exported by the DOS unit }
BEGIN
Regs.AH := $0F; { BIOS VIDEO Service $F: Get Current Video Mode }
Intr($10,Regs);
BX := Regs.AH; { Number of characters in a line returned in AH }
BY := ScreenLinesMatrix[QueryAdapterType,GetFontSize];
IF BY > 0 THEN
BEGIN
CheckForOverride(BX,BY); { See if something weird is on the bus... }
BuffSize := (BX * 2) * BY { Calculate the buffer size in bytes }
END
ELSE BuffSize := 0;
END;
{ This is the default override proc, and is called anytime you're }
{ not concerned about finding a nonstandard text adapter on the }
{ bus. (Funny graphics cards with normal text modes don't matter }
{ to this library.) If you want to capture any weird cards, you }
{ must provide your own override proc that can detect the card }
{ and return correct values for the visible X and Y dimensions. }
PROCEDURE NullOverride(VAR ForceX : Byte; VAR ForceY : Byte);
BEGIN
{ Like I said; Null... }
END;
FUNCTION Monochrome : Boolean;
BEGIN
CASE QueryAdapterType OF
None,MDA,EGAMono,VGAMono,MCGAMono : Monochrome := True;
CGA,EGAColor,VGAColor,MCGAColor : Monochrome := False
END {CASE }
END;
{ The initialization section provides some initial values for the }
{ exported variables TextBufferOrigin, VisibleX, VisibleY, and }
{ TextBufferSize, so that you can use the variables without further }
{ kafeuthering. }
BEGIN
TextBufferOrigin := GetTextBufferOrigin;
GetTextBufferStats(VisibleX,VisibleY,TextBufferSize,NullOverride);
END.